perm filename F4.F4[NEW,LCS]5 blob
sn#547906 filedate 1980-12-01 generic text, type T, neo UTF8
00100 C***** OUTLIM(I,J), UPDN(NST), NOIR(DUMMY), NOTAIL(X), POSIT(V), SLEND
00200 C***** JUSTXT
00300
00400 C K←15↔J←14↔ M←2↔ R2←5↔ X←6↔ L←4↔ R←7↔ A←11↔RY←3↔RZ←13↔JJ2←12
00500
00600 C OUTLIM: 0 ; FUNCTION OUTLIM(I,J)
00700 C SETO 0, ; OUTLIM=-1
00800 C MOVE 1,@(16) ; IF(RN(I+J).LT.R4)RETURN
00900 C ADD 1,@1(16)
01000 C MOVE 1,XRN-1(1) ;ALL AC1 WERE AC2 25/10/79********
01100 C CAMGE 1,.COMM.+5
01200 C JRA 16,2(16) ; IF(RN(I+J).GT.R5)RETURN
01300 C CAMG 1,.COMM.+6
01400 C SETZ 0, ; OUTLIM=0
01500 C JRA 16,2(16)
01600 FUNCTION OUTLIM(I,J)
01700 COMMON R2,JA,CENTR,J2,R3,R4,R5 /XRN/RN(1)
01800 OUTLIM=-1
01900 R=RN(I+J)
02000 IF(R.LT.R4)RETURN
02100 IF(R.GT.R5)RETURN
02200 OUTLIM=0
02300 END
02400
02500 SUBROUTINE UPDN(NST)
02600 INTEGER PWDS
02700 COMMON/XRN/RN(1) /KJY/ DONT,JY /POSI/S(8),JJ2,P
02800 COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L
02900 1/PTR/PWDS(1) /LIMIT/LIMIT,ITEM
03000 EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
03100 1,(R6,RJQ(4))
03200 DO 1 K=NST,ITEM
03300 L=PWDS(K)
03400 IF(RTLINE(L))GO TO 1
03500 RY=RN(L+1)
03600 IF(RY.GT.16)GO TO 1
03700 IF(RY.EQ.8)GO TO 1
03800 IF(RY.EQ.3)GO TO 1
03900 IF(RY.EQ.R6)GO TO 10
04000 IF(R6.NE.0)GO TO 1
04100 C DIDN'T MATCH THE CODE NUM.
04200 10 IF(RY.NE.4)GO TO 11
04300 IF(RN(L).LT.3)GO TO 1
04400 C A BAR LINE
04500 11 IF(OUTLIM(L,3))GO TO 2
04600 RN(L+4)=RN(L+4)+R11
04700 IF(K.LT.JJ2)JJ2=K
04800 2 IF(RY.LT.4)GO TO 1
04900 IF(RY.GE.7)GO TO 1
05000 C NO WIGGLE ON TRILL
05100 RNL=RN(L+5)
05200 IF(RY.NE.4.)GO TO 12
05300 IF(RNL.EQ.50.OR.RNL.EQ.150)GO TO 1
05400 C CRESC. OR BOX
05500 12 IF(OUTLIM(L,6))GO TO 1
05600 RN(L+5)=RNL+R11
05700 IF(JJ2)JJ2=K
05800 IF(K.LT.JJ2)JJ2=K
05900 1 CONTINUE
06000 END
06100
06200 C UPDN: 0 ;SUBROUTINE UPDN(NST)
06300 C ;INTEGER PWDS
06400 C ;COMMON/XRN/RN(4000) /KJY/ DONT,JY /POSI/S(8),JJ2,P
06500 C ;COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
06600 C ;1/PTR/PWDS(250),ITEM,LL,I,IX
06700 C MOVE 7,@(16) ;EQUIVALENCE (R4,RJQ(2)),(R5,RJQ(3)),(R11,RJQ(9))
06800 C SOJ 7, ;1,(R6,RJQ(4))
06900 C MOVE 15,LIMIT+1 ; AC7 IS K-1
07000 C ;; MOVE 15,PTR+=250 ; AC7 IS K-1
07100 C SOJ 15, ;(ITEM-1)
07200 C UPDN0: JSA 16,RTLINE ;DO 1 K=NST,ITEM
07300 C JUMP PTR(7) ;L=PWDS(K)
07400 C JUMPL UPDN1 ; IF(RTLINE(L))GO TO 1
07500 C MOVE 11,PTR(7) ;RY=RN(L+1) -- 11 IS L
07600 C MOVE 12,XRN(11) ;IF(RY.GT.16)GO TO 1
07700 C CAMG 12,[16.0] ; AC12=RY
07800 C CAME 12,[8.0] ;IF(RY.EQ.8)GO TO 1
07900 C CAMN 12,[3.0] ;IF(RY.EQ.3)GO TO 1
08000 C JRST UPDN1
08100 C CAMN 12,.COMM.+7 ;IF(RY.EQ.R6)GO TO 10
08200 C JRST UPDN10
08300 C SKIPE .COMM.+7 ;IF(R6.NE.0)GO TO 1
08400 C JRST UPDN1
08500 C UPDN10: CAME 12,[4.0] ; DIDN'T MATCH THE CODE NUM.
08600 C JRST UPDN11 ;10 ;IF(RY.NE.4)GO TO 11
08700 C MOVE 2,XRN-1(11) ;IF(RN(L).LT.3)GO TO 1
08800 C CAMGE 2,[3.0]
08900 C JRST UPDN1 ; A BAR LINE
09000 C UPDN11: JSA 16,OUTLIM ;11 IF(OUTLIM(L,3))GO TO 2
09100 C JUMP PTR(7)
09200 C JUMP [3]
09300 C JUMPL UPDN2
09400 C MOVE 2,.COMM.+=12 ;RN(L+4)=RN(L+4)+R11
09500 C FADRM 2,XRN+3(11)
09600 C ;IF(JJ2)JJ2=K
09700 C MOVE 0,7
09800 C AOJ
09900 C CAMGE POSI+=8
10000 C MOVEM POSI+=8 ;IF(K.LT.JJ2)JJ2=K
10100 C UPDN2: CAML 12,[4.0] ;2 ;IF(RY.LT.4)GO TO 1
10200 C CAML 12,[7.0] ;IF(RY.GE.7)GO TO 1
10300 C JRST UPDN1 ; NO WIGGLE ON TRILL
10400 C CAME 12,[4.0] ;IF(RY.NE.4.)GO TO 12
10500 C JRST UPDN12
10600 C MOVE XRN+4(11) ;IF(RN(L+5).EQ.50.OR. - - .EQ.150)GO TO 1
10700 C CAME [50.0] ;AC0 IS RN(L+5)
10800 C CAMN [150.0]
10900 C JRST UPDN1 ; CRESC. OR BOX
11000 C UPDN12: JSA 16,OUTLIM ;12 ;IF(OUTLIM(L,6))GO TO 1
11100 C JUMP PTR(7)
11200 C JUMP [6]
11300 C JUMPL UPDN1
11400 C MOVE 3,.COMM.+=12 ;RN(L+5)=RN(L+5)+R11
11500 C FADRM 3,XRN+4(11)
11600 C MOVE 0,7 ;IF(JJ2)JJ2=K
11700 C AOJ
11800 C CAMGE POSI+=8
11900 C MOVEM POSI+=8 ;IF(K.LT.JJ2)JJ2=K
12000 C UPDN1: CAMGE 7,15 ;1 ;CONTINUE
12100 C AOJA 7,UPDN0
12200 C JRA 16,1(16) ;END
12300
12400 SUBROUTINE NOIR
12500 END
12600
12700 FUNCTION NOTAIL(X)
12800 NOTAIL=0
12900 Z=ABS(X)
13000 IF(Z.LT..56.OR.Z.EQ..75)RETURN
13100 IF(Z.EQ..875.OR.Z.EQ..6)RETURN
13200 NOTAIL=-1
13300 END
13400
13500 FUNCTION POSIT(V)
13600 COMMON/RINP/R(10,85),POSNT(0/99)
13700 IF(V)V=-V
13800 C REREAD OR SOMETHING MAKES /1 C- 2/ GIVE A -2 FOR LAST NUM.!!!???
13900 K=V
14000 A=POSNT(K)
14100 POSIT=A+(POSNT(K+1)-A)*AMOD(V,1.0)
14200 C TYPE /2.3 -- FOR POSITION BETWEEN NTS 2 AND 3. ETC.
14300 END
14400
14500 C SLEND: 0 ; SUBROUTINE SLEND
14600 SUBROUTINE SLEND
14700 C MOVE 8,[8.0] ;INTEGER PWDS
14800 INTEGER PWDS
14900 C MOVE 7,SCM+=80 ;C TO FIND END POINTS OF STAVES
15000 CC COMMON/XRN/RN(1) /KJY/ DONT,JY /POSI/S(8),JJ2,P
15100 CC COMMON R2,JA,CENTR,J2,RJQ(18),RX6,JR,L
15200 CC 1/PTR/PWDS(1) /LIMIT/LIMIT,ITEM
15300 COMMON/XRN/RN(1) /SCM/V(78),I,LCNT,STAFF,LIST(200),REND
15400 1 /PTR/PWDS(1) /LIMIT/LIMIT,ITEM /RMOD/RMODE2,RSET4,IBEAM,
15500 1 NOSET,STEM,STUP,NTC,ENDP,RAD,RDD,ITB,POSB
15600 C MOVE 4,[4.0];COMMON/XRN/RN(2000),IT,POS,RA,NN,JB,RB,A,B,JMP,JK,C,
15700 C SETZ 5, ;DO 1 K=1,ITEM
15800 DO 1 K=1,ITEM
15900 L=PWDS(K)
16000 C SLN1: MOVE 6,PTR(5) ;L=PWDS(K)
16100 IF(RN(L+1).NE.8)GO TO 1
16200 C FOUND A STAFF
16300 IF(RN(L+2).NE.STAFF)GO TO 1
16400 C CAMN 8,XRN(6) ;C FOUND A STAFF ;IF(RN(L+2).NE.STAFF)GO TO 1
16500 C CAME 7,XRN+1(6) ;C GOT THE RIGHT ONE
16600 IF(ITB.LT.0)GO TO 2
16700 C JRST SLN1X ;IF(IT)GO TO 2
16800 POSB=202
16900 C SKIPGE RMOD+=10 ;POS=202
17000 C JRST SLN2 ;C NOW CHECK LEFT SIDE OF STAFF
17100 IF(RN(L).LT.4)RETURN
17200 C MOVSI 15,210624 ;[202.0] ;IF(RN(L).LT.4)RETURN
17300 C CAML 4,XRN-1(6) ;P6 WASN'T MENTIONED - SO IT =200
17400 C JRST SLN3
17500 POSB=RN(L+6)+2
17600 IF(POSB.EQ.2)POSB=202
17700 C MOVE 15,XRN+5(6) ;IF(POS.EQ.2)POS=202
17800 RETURN
17900 C FADR 15,[2.0] ;RETURN
18000 2 POSB=RN(L+3)-2.3
18100 C CAMN 15,[2.0] ;2 POS=RN(L+3)-2.3
18200 RETURN
18300 C MOVSI 15,210624 ;[202.0] ;RETURN
18400 1 CONTINUE
18500 C JRST SLN3 ;1 CONTINUE
18600 END
18700 C SLN2: MOVE 15,XRN+2(6) ;END
18800 C FSBR 15,[2.3]
18900 C SLN3: MOVEM 15,RMOD+=11
19000 C JRA 16,(16)
19100 C SLN1X: AOS 5
19200 C CAMGE 5,LIMIT+1
19300 C JRST SLN1
19400 C SKIPLE RMOD+=11 ;IF(POS.LE.0)RETURN
19500 C JRST SLN2-2 ;POS=202 (IN CASE THERE IS NO STAFF)
19600 C JRA 16,(16) ;END
19700
19800 SUBROUTINE JUSTXT(R2,R4,R5)
19900 COMMON/RINP/RNO(2,250),NO(350),NP(250)
20000 C ARRAY NO(X) USED IN 'MOVIT'. HOLDS ALL POINTS TO BE MOVED AT ANY TIME.
20100 COMMON /STF/RSTFAC(0/7),RSTJ2 /XRN/RN(1)
20200 COMMON R0,JA,CENTR,J2,RJQ(18),RX6,JR,L,RDIS,VY,JQ(17)
20300 1 /POSI/STFF(0/7),JJ2,POS /LIMIT/LIMIT,ITEM,LL,I,IX/PTR/KWDS(1)
20400 2 /ALF/INP(46),ACCX,ML,RRT,RZRO,NCNT,JSZ,OV,RSPC,KN,RA,RB,
20500 3 JLDGR,LDGR,JX,RW,RX,RY,RZ,JJ,RD,RQ,RE,RZZ,RN3,RN6,R44,R55
20550 C12/80 EQUIVALENCE (R6,RJQ(4)),(R7,RJQ(5))
20600 EQUIVALENCE (R8,RJQ(6)),(R9,RJQ(7))
20710 C12/80 1,(R3,RJQ(1)),(R8,RJQ(6)),(R9,RJQ(7)),(I2,INP(2))
20800 DATA RDX/1.5/
20900
21000 R0=11
21100 C R0 IS REALLY R2
21200 CALL GETPTS(1)
21300 C GO SETUP NO ARRAY FOR MOVIT
21400 R44=R4
21500 R55=R5
21600 RD=RDX*RSTJ2
21700 C RD IS IDEAL MINIMUM BETWEED CHAR. STRINGS
21800 6 RE=9999.
21900 KN=0
22000 R9=0
22100 R8=0
22200 RZZ=0
22300 DO 1 K=1,ITEM
22400 J=KWDS(K)
22500 R=RN(J+1)
22600 IF(R.NE.16.)GO TO 1
22700 IF(RN(J+2).NE.R2)GO TO 1
22800 C ASSUMES P9 HAS SPACE INFO
22900 JJ=KWDS(K+1)
23000 IF(RN(JJ+1).NE.16.)GO TO 2
23100 IF(RN(JJ).GT.7.)GO TO 1
23200 C JUMP IF FOUND CONTINUING CHARS. (P10=1)
23300 2 RA=RN(J+3)
23400 IF(RA.LT.R4.OR.RA.GT.R5)GO TO 1
23500 C NOW FIND NEXT WORD.
23600 RX=9999.
23700 33 DO 3 JX=1,ITEM
23800 JR=KWDS(JX)
23900 R=RN(JR+1)
24000 IF(R.NE.16.)GO TO 3
24100 IF(RN(JR+2).NE.R2)GO TO 3
24200 RZ=RN(JR+3)
24300 IF(RZ.LE.RA)GO TO 3
24400 IF(RZ.GT.R5)GO TO 3
24500 IF(RZ.GE.RX)GO TO 3
24600 RX=RZ
24700 3 CONTINUE
24800 IF(RX.EQ.9999.)GO TO 1
24900 C NOW WE HAVE NEXT WD.
25000 RW=RA+RN(J+9)*RN(J+5)*RSTJ2
25100 C RW = POS. OF 1ST CHAR + WIDTH OF CHAR. STRING
25200 RQ=RX-RW-RD
25300 IF(RQ.GE.0)GO TO 1
25400 CC RZZ=RZZ-RQ*1.5
25500 RQ=RQ*1.5
25600 R5=R5-RQ
25700 C RZZ=AMOUNT TO MOVE
25800 R8=-RQ
25900 KN=-1
26000 RX=RX-.01
26100 C WORDS ARE SOMETIMES A BIT TO THE RIGHT OF A NOTE.
26200 4 CALL MOVIT(RN,NO,RX,RE,R8,R9)
26300 1 CONTINUE
26400 R9=200
26500 R8=0
26600 R4=0
26700 5 IF(R5.NE.R9)CALL MOVIT(RN,NO,R4,R5,R8,R9)
26800 IF(KN.EQ.0)RETURN
26900 RD=RD-.5
27000 R4=R44
27100 R5=R55
27200 GO TO 6
27300 END